Interplay's Learn to Program Basic (Review Copy)/Learn to Program Basic Review Copy (Interplay)(June 23, 1998).ISO/pc/ltpbasic/projects/namelist.bas

BASIC Source File | 1998-02-21 | 6.2 KB | 349 lines

Rem Address Book
Rem By Steven Ohmert
Rem
Rem This will record names, addresses
Rem and phone numbers and allow you to
Rem save them in a file, NameList.TXT
Rem This file will be loaded each
Rem time you run the program, so
Rem your information is preserved.
Rem In programming, this is called
Rem 'Persistent Data'
Rem
Rem You can add many more features to
Rem this program on your own, too!

Rem Set up array of records
Rem Each 'field' in the record
Rem is identified by a number
Rem which corresponds to the
Rem second array index

Let numRecords = 20
Let numFields = 6
Let name = 1
Let addr = 2
Let city = 3
Let state = 4
Let zip = 5
Let phone = 6
Dim Record$(numRecords,numFields)

Rem Variables that track
Rem where we are
Let current = 1     ' current active record
Let field = 0       ' current active field
Let totalRecords = 0  ' total number in data base

Rem -- Load the file, and start going!
Gosub LoadFile
Gosub ShowRecord
Goto UserInterface

Rem Print a record
Rem
Rem Set current = the record to display
ShowRecord:
CLS
TextColor 166
Print "Record #";current;" of ";totalRecords
Print
If field = name Then
TextColor 235
Else
TextColor 21
Endif
Print "Name:    ";Record$(current,name)

If field = addr Then
TextColor 235
Else
TextColor 21
Endif
Print "Address: ";Record$(current,addr)

If field = city Then
TextColor 235
Else
TextColor 21
Endif
Print "City:    ";Record$(current,city)

If field = state Then
TextColor 235
Else
TextColor 21
Endif
Print "State:   ";
Print Record$(current,state)

If field = zip Then
TextColor 235
Else
TextColor 21
Endif
Print "Zip:     ";
Print Record$(current,zip)

If field = phone Then
TextColor 235
Else
TextColor 21
Endif
Print "Phone:   ";Record$(current,phone)

Rem Show the menu of options
Position 0,11
TextColor 83
Print "<PgUp> = previous  <PgDn> = next"
Print "Click on field to edit, press return"
Print
TextColor 67
Print "A";
TextColor 12
Print ")dd ";
TextColor 67
Print "D";
TextColor 12
Print ")elete ";
TextColor 67
Print "S";
TextColor 12
Print ")ave ";
TextColor 67
Print "B";
TextColor 12
Print ")ackup ";
TextColor 67
Print "Q";
TextColor 12
Print ")uit "

Return

Rem User Interface
Rem This is the 'Main Loop'
Rem the program will run through
Rem these steps until user quits

UserInterface:
While TRUE
oldRecord = current
field = 0

If Button Then
field = Int(MouseY / 16) - 1
If field < 1 then field = 0
If field > numFields Then field = 0
Endif

If KeyDown("PgUp") Then
current = current -1
While KeyDown("PgUp")
Wend
EndIf

If KeyDown("PgDn") Then
current = current +1
While KeyDown("PgDn")
Wend
If current > totalRecords Then current = totalRecords
EndIf

Rem Options
key$ = Inkey$
If key$ = "A" Then
totalRecords = totalRecords + 1
If totalRecords > numRecords Then totalRecords = numRecords
current = totalRecords
field = 1
Rem Setting field to 1 will force
Rem edit code below to activate
Endif
If key$ = "D" Then
Gosub DeleteRecord
Gosub ShowRecord
Endif
If key$ = "S" Then
Gosub SaveFile
Endif
If key$ = "B" Then
Gosub Backup
Gosub ShowRecord
Endif
If key$ = "Q" Then
Gosub Quit
Endif

If current < 1 Then current = 1
If current > numRecords Then current = numRecords

Rem If field has been selected
Rem Edit this field and all blank fields
While field <> 0
Gosub EditRecord
field = field + 1  ' go on to edit the next field (if blank)
If field > numFields Then
field = 0
Else
If Record$(current,field) <> "" Then
field = 0 ' don't edit a subsequent field if it has something in it already
Endif
Endif
Gosub ShowRecord
Wend

If current <> oldRecord Then
Gosub ShowRecord
Endif

Wend

EditRecord:
If field = 0 then field = 1
Gosub ShowRecord
Position 9,field+1
Print "                               ";
Position 9,field+1
Input new$
If new$ <> "" Then Record$(current,field) = new$
If current > totalRecords Then totalRecords = current
Return

Rem Save the list
SaveFile:
FileOpen "NameList.Txt",NEW EXIST
FileWrite totalRecords
For i = 1 to totalRecords
For j = 1 to numFields
A$ = Record$(i,j)
FileWrite A$
Next j
Next i
FileClose
Return

Rem Load the list
LoadFile:
i = 1
If FileExist("NameList.Txt") Then
FileOpen "NameList.Txt", EXIST
FileRead totalRecords
For i = 1 to totalRecords
For j = 1 to numFields
FileRead A$
Record$(i,j) = A$
Next j
Next i
FileClose
EndIf
Rem clear the remainder of array
while i < numRecords
For j = 1 to numFields
Record$(i,j) = ""
Next j
i = i+1
Wend

Return


Rem Delete current record
DeleteRecord:
Rem Don't do this if we have nothing to delete
If totalRecords = 0 Then Return

Rem Delete by copying everything above the
Rem current record over the top of the one
Rem before it.
For i = current To numRecords-1
For j = 1 to numFields
Record$(i,j) = Record$(i+1,j)
Next j
Next i
Rem We have one fewer records now
totalRecords = totalRecords - 1
Return

Rem Backup the file
Backup:
CLS
TextColor 168 'Columbia Blue
Print "Do you want to save your current work"
Print "before backing up? (Y/N) "
q$ = ""
While q$ = ""
q$ = Inkey$
Wend
If q$ = "Y" OR q$ = "y" Then
Gosub SaveFile
Print "Current work saved."
Endif
NameIt:
Print
Print "What do you want to call"
Print "the backup file? ";
Input backup$
If FileExist(backup$) Then
Print "That file already exists."
Input "Do you want to replace it? ",y$
If Left$(y$,1) = "Y" OR Left$(y$,1) = "y" Then
FileDelete(backup$)
Else
Print "Please choose a different name."
Goto NameIt
EndIf
Endif
Rem Copy the NameList file to the backup name
Rem Open the name list file. Identify this file with a file reference of 1
FileOpen "NameList.txt", EXIST 1
Rem Create the backup file. Identify this file with a file reference of 2
FileOpen backup$, NEW 2
Rem FileRead will return FALSE if
Rem there is no data left
While FileRead A$, 1
FileWrite A$, 2
Wend
FileClose 1
FileClose 2
Print
Print "File backed up to ";backup$
Input "Press Return",a$
Print
Return

Rem Quit program. Verify with user first, though
Quit:
CLS
TextColor 168 'Columbia Blue
Print "Are you sure you want to Quit? (Y/N) "
q$ = ""
While q$ = ""
q$ = Inkey$
Wend
If q$ <> "y" AND q$ <> "Y" Then
Rem Don't quit. Show record again and return
Gosub ShowRecord
Return
EndIf
Print
Rem Remind user to save file, if they want to
Print "Do you want to save your work"
Print "before quitting? (Y/N) ";
q$ = ""
While q$ = ""
q$ = Inkey$
Wend
If q$ = "y" OR q$ = "Y" Then
Gosub SaveFile
EndIf

Rem Now, quit
CLS
TextColor 21
Print "Goodbye"
End